home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_VB / VBINT.ZIP;1 / INTSUPT.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-06-04  |  4.7 KB  |  191 lines
  1. '---------------------------------------------------------------------------
  2. ' DOS Interrupt Demo Program, Copyright (c) 1994 Karl E. Peterson
  3. ' Redistributed by permission.
  4. '
  5. ' Requires: VBInt.DLL, VBRun300.DLL
  6. '
  7. ' This program may be distributed freely on the condition that it is
  8. ' distributed in full, and unmodified, and that no fee is charged for such
  9. ' distribution with the exception of reasonable media and shipping charges.
  10. ' Any or all portions of the source code may be incorporated into your own
  11. ' programs, and those programs may be distributed without payment of
  12. ' royalties on the condition that such programs differ substantially from
  13. ' this demonstration program.
  14. '
  15. ' This program is distributed AS IS.  The author acknowledges absolutely
  16. ' no liability for its use or misuse.  The sole purpose of this program is to
  17. ' demonstrate some of the powerful capabilities of VBInt.DLL, written and
  18. ' copyrighted by Rick Esterling.  Calling DOS interrupts from Windows is
  19. ' fairly "non-standard" behavior.  Users of this program acknowledge that
  20. ' they are doing so at their OWN RISK.
  21. '
  22. ' This demonstration program was created and distributed by:
  23. '   Karl E. Peterson
  24. '   Regional Transportation Council
  25. '   1351 Officers' Row
  26. '   Vancouver, Washington 98661
  27. '   CompuServe: 72302,3707
  28. '
  29. ' Your comments or questions are invited!
  30. '---------------------------------------------------------------------------
  31.  
  32. DefInt A-Z
  33. Option Explicit
  34.  
  35. Function ByteHi% (WordIn%)
  36.   If WordIn < 0 Then
  37.     ByteHi = (WordIn + &H10000) \ &H100
  38.   Else
  39.     ByteHi = WordIn \ &H100
  40.   End If
  41. End Function
  42.  
  43. Function ByteLo% (WordIn%)
  44.   ByteLo = WordIn And 255
  45. End Function
  46.  
  47. Function ByteSwap (WordIn%) As Integer
  48.   
  49.   Dim ByteHi%, ByteLo%, High&
  50.  
  51.   If WordIn < 0 Then
  52.     ByteHi = (WordIn + 65536) \ 256
  53.   Else
  54.     ByteHi = WordIn \ 256
  55.   End If
  56.   ByteLo = WordIn And 255
  57.  
  58.   High& = ByteLo * 256&
  59.   If High& > 32767 Then
  60.     ByteLo = High& - 65536
  61.   Else
  62.     ByteLo = High&
  63.   End If
  64.   ByteSwap = ByteLo + ByteHi
  65.  
  66. End Function
  67.  
  68. Function FmtDirEntry$ (f As FileDataType)
  69.  
  70.   Dim t$, fde$, at$
  71.   t$ = Chr$(9)
  72.   at$ = String$(4, "-")
  73.   
  74.   If f.Attr And attrDirectory Then
  75.     fde$ = RTrim$(f.FileName) + t$
  76.     fde$ = fde$ + "[Sub-Dir]" + t$
  77.   Else
  78.     fde$ = LCase$(RTrim$(f.FileName)) + t$
  79.     fde$ = fde$ + Format$(f.Size, "#,##0") + t$
  80.   End If
  81.  
  82.   fde$ = fde$ + Format$(f.sDate, "short date") + t$
  83.   fde$ = fde$ + LCase$(Format$(f.sDate, "medium time")) + t$
  84.   
  85.   If f.Attr And attrReadOnly Then
  86.     Mid$(at$, 1, 1) = "r"
  87.   End If
  88.   If f.Attr And attrHidden Then
  89.     Mid$(at$, 2, 1) = "h"
  90.   End If
  91.   If f.Attr And attrSystem Then
  92.     Mid$(at$, 3, 1) = "s"
  93.   End If
  94.   If f.Attr And attrArchived Then
  95.     Mid$(at$, 4, 1) = "a"
  96.   End If
  97.   fde$ = fde$ + at$
  98.   
  99.   FmtDirEntry$ = fde$
  100.  
  101. End Function
  102.  
  103. Function GetWinDir$ ()
  104.   Dim Buffer$, Ret%
  105.   Buffer = String$(144, 0)
  106.   Ret% = GetWindowsDirectory(Buffer, Len(Buffer))
  107.   GetWinDir$ = Left$(Buffer, Ret)
  108. End Function
  109.  
  110. Function GetWinVersion ()
  111.   
  112.   ' Initialize some vars
  113.       Dim vernum&, vermaj%, vermin%
  114.       Dim verDos%, verWin%
  115.  
  116.   ' Get system version info
  117.       vernum& = GetVersion&()
  118.  
  119.   ' Get Dos Version (what the hell, it's there)
  120.       verDos = CInt(vernum& / &H10000)
  121.       vermaj = verDos / 256
  122.       vermin = verDos And &HFF
  123.       verDos = vermaj * 100 + vermin
  124.  
  125.   ' Get Windows Version
  126.       verWin = CInt(vernum& And &HFFFF&)
  127.       vermaj = verWin And &HFF
  128.       vermin = CInt(verWin / 256)
  129.       verWin = vermaj * 100 + vermin
  130.  
  131.   GetWinVersion = verWin
  132. End Function
  133.  
  134. Function HexFmt2$ (ValIn%)
  135.   If ValIn >= 0 And ValIn <= &HFF Then
  136.     HexFmt2$ = Right$("00" + Hex$(ValIn), 2)
  137.   End If
  138. End Function
  139.  
  140. Function HexFmt4$ (ValIn%)
  141.     HexFmt4$ = Right$("0000" + Hex$(ValIn), 4)
  142. End Function
  143.  
  144. Function WinIsNT () As Integer
  145.   Dim Ret%
  146.   Ret = GetWinFlags()
  147.   If Ret And WF_WINNT Then
  148.     WinIsNT = True
  149.   Else
  150.     WinIsNT = False
  151.   End If
  152. End Function
  153.  
  154. Function WordCombine% (ByteHi%, ByteLo%)
  155.   Dim High&
  156.   High& = ByteHi
  157.   High& = High& * 256
  158.   If High& > 32767 Then
  159.     ByteHi = High& - 65536
  160.   Else
  161.     ByteHi = High&
  162.   End If
  163.   WordCombine = ByteHi + ByteLo
  164. End Function
  165.  
  166. Function WordHi% (LongIn&)
  167.   If LongIn < 0 Then
  168.     WordHi = LongIn \ &H10000 - 1
  169.   Else
  170.     WordHi = LongIn \ &H10000
  171.   End If
  172. End Function
  173.  
  174. Function WordLo% (LongIn&)
  175.   If (LongIn And &HFFFF&) > &H7FFF Then
  176.     WordLo = (LongIn And &HFFFF&) - &H10000
  177.   Else
  178.     WordLo = LongIn And &HFFFF&
  179.   End If
  180. End Function
  181.  
  182. Sub WordSplit (WordIn%, ByteHi%, ByteLo%)
  183.   If WordIn < 0 Then
  184.     ByteHi = (WordIn + 2 ^ 16) \ 256
  185.   Else
  186.     ByteHi = WordIn \ 256
  187.   End If
  188.   ByteLo = WordIn And 255
  189. End Sub
  190.  
  191.